Descriptives

Housing precarity

tar_load(silc_merged)
tar_load(silc_merged_households)

Effect of housing benefits on housing overburden

Comparison of housing precarity dimensions with and without housing benefits can be made easily only for housing overburden (by calculating overburden based on income with housing benefits and without housing benefits). This assumes that the households would not move if they did not receive housing benefits. Comparison of other dimensions require some modelling.

tar_load(all_silc_households)
all_silc_households %>% 
  select(country, year, mean_housing_overburden, mean_housing_overburden_wo_hb) %>% 
  pivot_longer(., cols = 3:4, names_to = "type", values_to = "pct") %>% 
  mutate(type = case_when(
    grepl("wo_hb", type) ~ "Without housing benefits",
    !grepl("wo_hb", type) ~ "With housing benefits"
  )) %>% 
  ggplot(., aes(x = year, y = pct, colour = type)) + 
  geom_point(alpha = 0.8) + 
  scale_colour_viridis_d() + 
  facet_wrap(~country, scales = "free_y") + 
  theme_minimal() + 
  labs(x = "Year", y = "Share of households", 
       title = "Housing overburden", 
       colour = "") + 
  theme(legend.position = "top")
## Warning: Removed 93 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>% 
  ungroup() %>% 
  filter(year == 2023) %>% 
  select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb) %>% 
  pivot_longer(., cols = c(income_share_on_housing, income_share_on_housing_wo_hb), 
               names_to = "income_type", values_to = "income_share_on_housing") %>% 
  mutate(income_type = if_else(income_type == "income_share_on_housing", 
                               "With housing benefits", 
                               "Without housing benefits")) %>% 
  ggplot(., aes(x = income_share_on_housing, colour = income_type)) + 
  geom_density() + 
  facet_wrap(~country, scales = "free_y") + 
  theme_minimal() + 
  labs(x = "Income share on housing", y = "Density", colour = "Income") + 
  theme(legend.position = "top")
## Warning: Removed 12260 rows containing non-finite outside the scale range
## (`stat_density()`).

silc_merged_households %>% 
  ungroup() %>% 
  filter(year == 2023) %>% 
  select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb, 
         hh_cross_weight) %>% 
  mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>% 
  group_by(country) %>% 
  summarise(mean_reduction_income_share = wtd.mean(diff_pp, hh_cross_weight, 
                                                   na.rm = TRUE)) %>% 
  arrange(desc(mean_reduction_income_share)) %>% 
  knitr::kable(., digits = 2, col.names = c("Country", "Mean reduction of income share on housing (perc. points)"))
Country Mean reduction of income share on housing (perc. points)
FI 2.18
IE 1.38
DE 1.21
NL 1.17
SE 1.09
DK 1.06
FR 1.01
AT 0.78
CZ 0.46
LT 0.26
LV 0.25
NO 0.23
EE 0.19
BE 0.16
CY 0.14
LU 0.12
MT 0.10
SI 0.07
HU 0.06
HR 0.06
ES 0.06
PL 0.04
IT 0.04
PT 0.01
EL 0.01
BG 0.00
RO 0.00
SK 0.00

Tenants

tar_load(all_silc_households_tenants)
all_silc_households_tenants %>% 
  select(country, year, mean_housing_overburden, mean_housing_overburden_wo_hb) %>% 
  pivot_longer(., cols = 3:4, names_to = "type", values_to = "pct") %>% 
  mutate(type = case_when(
    grepl("wo_hb", type) ~ "Without housing benefits",
    !grepl("wo_hb", type) ~ "With housing benefits"
  )) %>% 
  ggplot(., aes(x = year, y = pct, colour = type)) + 
  geom_point(alpha = 0.8) + 
  scale_colour_viridis_d() + 
  facet_wrap(~country, scales = "free_y") + 
  theme_minimal() + 
  scale_y_continuous(labels = scales::label_percent(scale = 1)) + 
  labs(x = "Year", y = "Share of households", 
       title = "Housing overburden", 
       subtitle = "Tenants",
       colour = "") + 
  theme(legend.position = "top")
## Warning: Removed 93 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>% 
  ungroup() %>% 
  filter(year == 2023) %>% 
  filter(tenure_status %in% c("Tenant, rent at market price", 
                              "Tenant, rent at reduced price", 
                              "Tenant, rent free")) %>% 
  select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb) %>% 
  pivot_longer(., cols = c(income_share_on_housing, income_share_on_housing_wo_hb), 
               names_to = "income_type", values_to = "income_share_on_housing") %>% 
  mutate(income_type = if_else(income_type == "income_share_on_housing", 
                               "With housing benefits", 
                               "Without housing benefits")) %>% 
  ggplot(., aes(x = income_share_on_housing, colour = income_type)) + 
  geom_density() + 
  facet_wrap(~country, scales = "free_y") + 
  theme_minimal() + 
  labs(x = "Income share on housing", y = "Density", colour = "Income") + 
  theme(legend.position = "top")
## Warning: Removed 2298 rows containing non-finite outside the scale range
## (`stat_density()`).

silc_merged_households %>% 
  ungroup() %>% 
  filter(year == 2023) %>% 
  filter(tenure_status %in% c("Tenant, rent at market price", 
                              "Tenant, rent at reduced price", 
                              "Tenant, rent free")) %>% 
  select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb, 
         hh_cross_weight) %>% 
  mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>% 
  group_by(country) %>% 
  summarise(mean_reduction_income_share = wtd.mean(diff_pp, hh_cross_weight, 
                                                   na.rm = TRUE)) %>% 
  arrange(desc(mean_reduction_income_share)) %>% 
  knitr::kable(., digits = 2, col.names = c("Country", "Mean reduction of income share on housing (perc. points)"))
Country Mean reduction of income share on housing (perc. points)
FI 5.58
IE 3.40
NL 2.75
SE 2.43
FR 2.43
DK 2.15
DE 1.97
CZ 1.37
AT 1.15
LV 0.65
NO 0.46
LT 0.38
CY 0.35
MT 0.33
BE 0.31
SI 0.28
EE 0.28
PL 0.24
LU 0.24
ES 0.19
HR 0.16
IT 0.10
PT 0.06
HU 0.05
BG 0.00
EL 0.00
RO 0.00
SK 0.00

Owners

tar_load(all_silc_households_owners)
all_silc_households_owners %>% 
  select(country, year, mean_housing_overburden, mean_housing_overburden_wo_hb) %>% 
  pivot_longer(., cols = 3:4, names_to = "type", values_to = "pct") %>% 
  mutate(type = case_when(
    grepl("wo_hb", type) ~ "Without housing benefits",
    !grepl("wo_hb", type) ~ "With housing benefits"
  )) %>% 
  ggplot(., aes(x = year, y = pct, colour = type)) + 
  geom_point(alpha = 0.8) + 
  scale_colour_viridis_d() + 
  facet_wrap(~country, scales = "free_y") + 
  theme_minimal() + 
  scale_y_continuous(labels = scales::label_percent(scale = 1)) + 
  labs(x = "Year", y = "Share of households", 
       title = "Housing overburden", 
       subtitle = "Owners",
       colour = "") + 
  theme(legend.position = "top")
## Warning: Removed 93 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>% 
  ungroup() %>% 
  filter(year == 2023) %>% 
  filter(tenure_status %in% c("Owner without outstanding mortgage", 
                              "Owner with outstanding mortgage")) %>% 
  select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb) %>% 
  pivot_longer(., cols = c(income_share_on_housing, income_share_on_housing_wo_hb), 
               names_to = "income_type", values_to = "income_share_on_housing") %>% 
  mutate(income_type = if_else(income_type == "income_share_on_housing", 
                               "With housing benefits", 
                               "Without housing benefits")) %>% 
  ggplot(., aes(x = income_share_on_housing, colour = income_type)) + 
  geom_density() + 
  facet_wrap(~country, scales = "free_y") + 
  theme_minimal() + 
  labs(x = "Income share on housing", y = "Density", colour = "Income") + 
  theme(legend.position = "top")
## Warning: Removed 9108 rows containing non-finite outside the scale range
## (`stat_density()`).

silc_merged_households %>% 
  ungroup() %>% 
  filter(year == 2023) %>% 
  filter(tenure_status %in% c("Owner without outstanding mortgage", 
                              "Owner with outstanding mortgage")) %>% 
  select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb, 
         hh_cross_weight) %>% 
  mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>% 
  group_by(country) %>% 
  summarise(mean_reduction_income_share = wtd.mean(diff_pp, hh_cross_weight, 
                                                   na.rm = TRUE)) %>% 
  arrange(desc(mean_reduction_income_share)) %>% 
  knitr::kable(., digits = 2, col.names = c("Country", "Mean reduction of income share on housing (perc. points)"))
Country Mean reduction of income share on housing (perc. points)
IE 0.43
AT 0.37
LT 0.24
SE 0.20
EE 0.17
LV 0.15
DE 0.12
CZ 0.11
FI 0.09
BE 0.08
HU 0.06
LU 0.06
HR 0.05
NO 0.05
FR 0.03
DK 0.02
CY 0.02
ES 0.02
IT 0.01
MT 0.01
NL 0.01
EL 0.01
PL 0.01
PT 0.00
BG 0.00
RO 0.00
SI 0.00
SK 0.00

All

diff_all <- all_silc_households %>% 
  mutate(diff = mean_housing_overburden_wo_hb - mean_housing_overburden) %>% 
  group_by(country) %>% 
  summarise(mean_diff_overburden = round(mean(diff, na.rm = TRUE), 2), 
            .groups = "drop") %>% 
  arrange(desc(mean_diff_overburden))

diff_tenants <- all_silc_households_tenants %>% 
  mutate(diff = mean_housing_overburden_wo_hb - mean_housing_overburden) %>% 
  group_by(country) %>% 
  summarise(mean_diff_overburden_tenants = round(mean(diff, na.rm = TRUE), 2), 
            .groups = "drop") %>% 
  arrange(desc(mean_diff_overburden_tenants))

diff_owners <- all_silc_households_owners %>% 
  mutate(diff = mean_housing_overburden_wo_hb - mean_housing_overburden) %>% 
  group_by(country) %>% 
  summarise(mean_diff_overburden_owners = round(mean(diff, na.rm = TRUE), 2), 
            .groups = "drop") %>% 
  arrange(desc(mean_diff_overburden_owners))

Average

purrr::reduce(list(diff_all, diff_tenants, diff_owners), 
              ~full_join(.x, .y, by = "country")) %>% 
  mutate(ratio = mean_diff_overburden_tenants / mean_diff_overburden_owners) %>% 
  knitr::kable(., col.names = c("Country", "Overburden diff. (all)", 
                                "Overburden diff. (tenants)", 
                                "Overburden diff. (owners)", 
                                "Ratio"), 
               digits = 2)
Country Overburden diff. (all) Overburden diff. (tenants) Overburden diff. (owners) Ratio
NO 10.33 7.03 6.24 1.13
FR 2.24 5.66 0.06 94.33
SE 1.77 3.19 0.81 3.94
DK 1.73 3.51 0.02 175.50
DE 1.48 2.50 0.14 17.86
NL 1.25 3.00 0.01 300.00
FI 1.20 3.01 0.09 33.44
IE 1.11 3.22 0.19 16.95
AT 0.46 0.87 0.01 87.00
CY 0.39 0.88 0.11 8.00
LV 0.39 0.83 0.28 2.96
CZ 0.37 1.05 0.15 7.00
CH 0.31 0.50 0.00 Inf
LT 0.27 0.60 0.22 2.73
EE 0.15 0.40 0.08 5.00
PL 0.13 0.52 0.04 13.00
SI 0.12 0.46 0.00 Inf
ES 0.11 0.34 0.03 11.33
HU 0.11 0.16 0.10 1.60
HR 0.09 0.25 0.07 3.57
LU 0.09 0.22 0.03 7.33
IT 0.05 0.17 0.01 17.00
RS 0.05 0.08 0.05 1.60
PT 0.04 0.10 0.02 5.00
RO 0.02 0.04 0.02 2.00
EL 0.01 0.01 0.01 1.00
MT 0.01 0.03 0.01 3.00
BG 0.00 0.00 0.00 NaN
SK 0.00 0.00 0.00 NaN
BE -0.10 -0.14 0.00 Inf
IS NaN NaN NaN NaN
UK NaN NaN NaN NaN

Income quantiles

silc_merged_households %>% 
  ungroup() %>% 
  group_by(country, year, income_disposable_eqi_quantile) %>% 
  filter(!is.na(income_disposable_eqi_quantile)) %>% 
  summarise(housing_overburden = 
              wtd.mean(housing_overburden, hh_cross_weight, 
                       na.rm = TRUE), 
            housing_overburden_wo_hb = 
              wtd.mean(housing_overburden_wo_hb, hh_cross_weight, 
                       na.rm = TRUE), .groups = "drop") %>% 
  select(country, year, income_disposable_eqi_quantile, 
         housing_overburden, housing_overburden_wo_hb) %>% 
  pivot_longer(., cols = c(housing_overburden, 
         housing_overburden_wo_hb), names_to = "overburden", 
         values_to = "share") %>% 
  filter(overburden == "housing_overburden") %>% 
  ggplot(., aes(x = year, y = share, 
                colour = income_disposable_eqi_quantile
                # shape = overburden
                )) + 
  geom_point(alpha = 0.8) + 
  scale_colour_viridis_d() + 
  facet_wrap(~country, scales = "free_y") + 
  theme_minimal() + 
  scale_y_continuous(labels = scales::label_percent(scale = 100)) + 
  labs(x = "Year", y = "Share of households", 
       title = "Housing overburden", 
       colour = "Equalised disposable income") + 
  theme(legend.position = "top")
## Warning: Removed 5 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>% 
  ungroup() %>% 
  filter(year == 2023) %>% 
  filter(!is.na(income_disposable_eqi_quantile)) %>% 
  select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb, income_disposable_eqi_quantile, 
         hh_cross_weight) %>% 
  mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>% 
  group_by(country, income_disposable_eqi_quantile) %>% 
  summarise(mean_reduction_income_share = wtd.mean(diff_pp, hh_cross_weight, 
                                                   na.rm = TRUE)) %>% 
  ggplot(., aes(x = income_disposable_eqi_quantile, y = mean_reduction_income_share)) + 
  geom_point() + 
  coord_flip() + 
  facet_wrap(~country) + 
  theme_minimal() + 
  labs(y = "Mean reduction of income share on housing (perc. points)", 
       x = "Quantile of equalised disposable income")
## `summarise()` has grouped output by 'country'. You can override using the
## `.groups` argument.

Economic activity

silc_merged_households %>% 
  ungroup() %>% 
  group_by(country, year, econ_status) %>% 
  filter(!is.na(econ_status)) %>% 
  # filter(econ_status != "Other") %>% 
  mutate(econ_status = case_when(
    econ_status == "Employed" ~ "Employed",
    econ_status == "Retired" ~ "Retired",
    econ_status %in% c("Unemployed", "Fulfilling domestic tasks", 
                       "Unable to work due to health problems") ~ "Inactive (unemployed, unable to work, at home)",
    econ_status %in% c("Student", "Other") ~ "Other",
  )) %>% 
  summarise(housing_overburden = 
              wtd.mean(housing_overburden, hh_cross_weight, 
                       na.rm = TRUE), 
            housing_overburden_wo_hb = 
              wtd.mean(housing_overburden_wo_hb, hh_cross_weight, 
                       na.rm = TRUE), .groups = "drop") %>% 
  select(country, year, econ_status, 
         housing_overburden, housing_overburden_wo_hb) %>% 
  pivot_longer(., cols = c(housing_overburden, 
         housing_overburden_wo_hb), names_to = "overburden", 
         values_to = "share") %>% 
  filter(overburden == "housing_overburden") %>% 
  ggplot(., aes(x = year, y = share, 
                colour = econ_status
                # shape = overburden
                )) + 
  geom_point(alpha = 0.8) + 
  scale_colour_viridis_d() + 
  facet_wrap(~country, scales = "free_y") + 
  theme_minimal() + 
  scale_y_continuous(labels = scales::label_percent(scale = 100)) + 
  labs(x = "Year", y = "Share of households", 
       title = "Housing overburden", 
       colour = "Econ. status") + 
  theme(legend.position = "top")
## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).

silc_merged_households %>% 
  ungroup() %>% 
  filter(year == 2023) %>% 
  filter(!is.na(econ_status)) %>% 
  select(country, hh_id, income_share_on_housing, income_share_on_housing_wo_hb, econ_status, 
         hh_cross_weight) %>% 
  mutate(diff_pp = income_share_on_housing_wo_hb - income_share_on_housing) %>% 
  group_by(country, econ_status) %>% 
  summarise(mean_reduction_income_share = 
              wtd.mean(diff_pp, hh_cross_weight, na.rm = TRUE)) %>% 
  ggplot(., aes(x = econ_status, y = mean_reduction_income_share)) + 
  geom_point() + 
  coord_flip() + 
  facet_wrap(~country) + 
  theme_minimal() + 
  labs(y = "Mean reduction of income share on housing (perc. points)", 
       x = "Econ. status")
## `summarise()` has grouped output by 'country'. You can override using the
## `.groups` argument.

Age

# TODO:

Education

# TODO:

Models of housing overburden

I want to estimate housing overburden/share of income on housing

Insecurity

silc_merged_households %>% 
  mutate(insecure = arrears_mortgage_rent %in% 
           c("Yes, once", "Yes, twice or more") |
           arrears_utility %in% c("Yes, once", "Yes, twice or more")) %>% 
  group_by(country, year) %>% 
  summarise(share_insecure = wtd.mean(insecure, hh_cross_weight, 
                                      na.rm = TRUE), 
            .groups = "drop") %>% 
  ggplot(., aes(x = year, y = share_insecure)) + 
  geom_point() + 
  geom_line() + 
  facet_wrap(~country) + 
  theme_minimal()

Housing benefits takeup

benefits_takeup <- silc_merged_households %>% 
  group_by(country, year) %>% 
  summarise(housing_allowance_takeup_pct = wtd.mean(takeup_allowance_housing, hh_cross_weight))
## `summarise()` has grouped output by 'country'. You can override using the
## `.groups` argument.
ggplot(benefits_takeup, aes(x = year, y = housing_allowance_takeup_pct)) + 
  geom_point() + 
  geom_line() + 
  facet_wrap(~country, scales = "free_y") + 
  scale_y_continuous(labels = scales::label_percent()) + 
  theme_minimal() + 
  labs(y = "Share of households", 
       x = "Year")
## Warning: Removed 102 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 8 rows containing missing values or values outside the scale range
## (`geom_line()`).

Tenants

benefits_takeup_tenants <- silc_merged_households %>% 
  filter(tenure_status %in% c("Tenant, rent at market price", 
                              "Tenant, rent at reduced price", 
                              "Tenant, rent free")) %>% 
  group_by(country, year) %>% 
  summarise(housing_allowance_takeup_pct = wtd.mean(takeup_allowance_housing, hh_cross_weight), 
            .groups = "drop")

ggplot(benefits_takeup_tenants, 
       aes(x = year, y = housing_allowance_takeup_pct)) + 
  geom_point() + 
  geom_line() + 
  facet_wrap(~country, scales = "free_y") + 
  scale_y_continuous(labels = scales::label_percent()) + 
  theme_minimal() + 
  labs(y = "Share of households", 
       x = "Year")
## Warning: Removed 102 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 8 rows containing missing values or values outside the scale range
## (`geom_line()`).

Owners

benefits_takeup_owners <- silc_merged_households %>% 
  filter(tenure_status %in% c("Owner without outstanding mortgage", 
                              "Owner with outstanding mortgage")) %>% 
  group_by(country, year) %>% 
  summarise(housing_allowance_takeup_pct = wtd.mean(takeup_allowance_housing, hh_cross_weight), 
            .groups = "drop")

ggplot(benefits_takeup_owners, 
       aes(x = year, y = housing_allowance_takeup_pct)) + 
  geom_point() + 
  geom_line() + 
  facet_wrap(~country, scales = "free_y") + 
  scale_y_continuous(labels = scales::label_percent()) + 
  theme_minimal() + 
  labs(y = "Share of households", 
       x = "Year")
## Warning: Removed 102 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 8 rows containing missing values or values outside the scale range
## (`geom_line()`).